home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / Except / HVEST.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-09-15  |  1.7 KB  |  73 lines
  1. unit HVEST;
  2. //
  3. // Exceptional Stack Tracing
  4. //
  5. // Written by Hallvard Vassbotn, September 1999
  6. //
  7. interface
  8.  
  9. var
  10.   ESTEnabled: boolean = true;
  11.   ESTRaw    : boolean = false;
  12.  
  13. implementation
  14.  
  15. uses
  16.   HVExceptNotify,
  17.   Windows,
  18.   SysUtils,
  19.   HVYAST32,
  20.   HVHookDLL;
  21.  
  22. {$W+} // Must have stack frames on for this code
  23.  
  24. var
  25.   OldExceptNotify: TExceptNotify;
  26.  
  27. procedure NotifyException(ExceptObj: TObject; ExceptAddr: pointer; OSException: boolean);
  28. const
  29.   Recursive: boolean = false;
  30. var
  31.   IgnoreLevels: integer;
  32.   FirstCaller : pointer;
  33. begin
  34.   // We have to be careful what we are doing in here -
  35.   // if an exception is raised, we could get endless recursive behaviour
  36.   if not Recursive then
  37.   begin
  38.     Recursive := true;
  39.  
  40.     // Ignore 3 levels for frame-based tracing, 5 levels for raw tracing
  41.     IgnoreLevels := 3;
  42.     if ESTRaw then
  43.       IgnoreLevels := 5;
  44.  
  45.     // Explicitly add the exception address to the stack trace if this
  46.     // is an OS type exception - the address is not on the stack
  47.     FirstCaller := nil;
  48.     if OSException then
  49.       FirstCaller := ExceptAddr;
  50.  
  51.     // Now save the stack trace to the global StackDump array
  52.     SaveStackTrace(ESTRaw, IgnoreLevels, FirstCaller);
  53.  
  54.     // Chain back to any old ExceptionNotify hooks
  55.     if Assigned(OldExceptNotify) then
  56.       OldExceptNotify(ExceptObj, ExceptAddr, OSException);
  57.  
  58.     // We're home safe
  59.     Recursive := false;
  60.   end;
  61. end;
  62.  
  63. initialization
  64.   OldExceptNotify             := HVExceptNotify.ExceptNotify;
  65.   HVExceptNotify.ExceptNotify := NotifyException;
  66.  
  67. finalization
  68.   HVExceptNotify.ExceptNotify := OldNotifyException;
  69.   OldExceptNotify             := nil;
  70.  
  71. end.
  72.  
  73.